perm filename CYCDRG.LSP[3,LMM] blob sn#037476 filedate 1973-04-21 generic text, type T, neo UTF8

(DEFPROP CYCDRGFNS
 (CYCDRGFNS PATFACE FNODLST PATNODFC NODEPICK2 NODEPICK3 NODECHK PATCONN PATPTS PATPOINTS)
VALUE)

(DEFPROP PATFACE
 (LAMBDA (X) (CADDR X))
EXPR)

(DEFPROP FNODLST
 (LAMBDA(X)
  (PROG	(Y Y1)
	(SETQ Y (CDR X))
	(SETQ Y1 (CADDAR Y))
   B	(COND ((NULL (SETQ Y (CDR Y))) (RETURN (CONS (CAR X) Y1))) (T (SETQ Y1 (UNION Y1 (CADDAR Y)))))
	(GO B)))
EXPR)

(DEFPROP PATNODFC
 (LAMBDA (X) (CADDDR X))
EXPR)

(DEFPROP NODEPICK2
 (LAMBDA (PS) (NODEPICK3 PS NIL NIL))
EXPR)

(DEFPROP NODEPICK3
 (LAMBDA(PS1 LST USD)
  (PROG	(X Y)
	(SETQ X (CDAR PS1))
   B	(COND ((NULL X) (RETURN NIL))
	      ((MEMQ (CAR X) USD) NIL)
	      ((CDR PS1) (GO A))
	      (T (RETURN (CONS (CONS (CAAR PS1) (CAR X)) LST))))
   C	(SETQ X (CDR X))
	(GO B)
   A	(COND ((NOT (NODECHK (CAAR PS1) (CAR X) LST)) (GO C)))
	(SETQ Y (NODEPICK3 (CDR PS1) (CONS (CONS (CAAR PS1) (CAR X)) LST) (CONS (CAR X) USD)))
	(COND (Y (RETURN Y)))
	(GO C)))
EXPR)

(DEFPROP NODECHK
 (LAMBDA(PX NX LST)
  (PROG	(Y Y1 Y2)
	(SETQ Y2 (CONN NX))
	(RETURN
	 (FOR Y IN (CDR (ASSOC PX (PATCONN CURPAT))) AS Y1 IS (ASSOC2 Y LST) IF Y1 AND (MEMBER (CDR Y1) Y2)))))
EXPR)

(DEFPROP PATCONN
 (LAMBDA (X) (CADR X))
EXPR)

(DEFPROP PATPTS
 (LAMBDA(X LC)
  (FOR NEW Y IN X AS NEW Z IS (ASSOC2 (CAR Y) LC) LIST (LIST (CDR Y) (PLUS (CADR Z) 15.) (PLUS (CADDR Z) 15.))))
EXPR)

(DEFPROP PATPOINTS
 (LAMBDA (X) (CADR (CDDDDR X)))
EXPR)